home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
print
/
pgraf130.zip
/
PASCAL.ZIP
/
PGRAFBUF.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-10-05
|
3KB
|
136 lines
{$B-} { Short circuit boolean evaluation }
{$I-} { I/O checking OFF }
{$R-} { Range checking OFF }
{$S-} { Stack checking OFF }
{$V-} { Var-str check OFF }
{$F+} { Force FAR calls ON }
UNIT PGrafbuf;
INTERFACE
uses pgraph;
procedure init_buffering;
CONST
UnitVersion = '1.00' ;
UnitVerDate = '21 Jul 91' ;
IMPLEMENTATION {============================================================}
VAR
ExitSave : pointer ;
OriginalVector : pointer ;
type buffer = array[0..$7fff] of byte;
var buff_ptr: array[0..31] of ^buffer;
{---------------------------------------------------------------------------}
{ L O C A L P R O C E D U R E S }
{---------------------------------------------------------------------------}
PROCEDURE TerminateUnit ;
BEGIN { TerminateUnit }
ExitProc := ExitSave
END { TerminateUnit } ;
PROCEDURE InitializeUnit ;
{ initialize variables }
VAR
i: integer;
Index : word ;
k : byte ;
ID_Var : string[11] ;
begin
ExitSave := ExitProc ;
ExitProc := @TerminateUnit;
END { InitializeUnit } ;
procedure pgr_graphfreemem(ptr: pointer; size: longint);
begin
freemem(ptr, size);
end;
function pgr_graphgetmem(size: longint): pointer;
var temp: pointer;
begin
if (maxavail < size) or (size > 65535)
then temp := nil
else getmem(temp, size);
pgr_graphgetmem := temp;
end;
function pgr_graphgetbuff(size: longint): integer;
var i: integer;
var got_ok: boolean;
begin
if size > $8000 * 32
then got_ok := false
else begin
got_ok := true;
if size >= $8000
then for i := 0 to (size div $8000) - 1 do
if (maxavail < $8000)
then got_ok := false
else begin
getmem(buff_ptr[i], $8000);
fillchar(buff_ptr[i]^, $8000, 0);
end;
if size mod $8000 <> 0 then begin
if (maxavail < size mod $8000)
then got_ok := false
else begin
getmem(buff_ptr[size div $8000], size mod $8000);
fillchar(buff_ptr[size div $8000]^, size mod $8000, 0);
end;
end;
end;
pgr_graphgetbuff := ord(got_ok);
end;
procedure pgr_graphfreebuff(size: longint);
var i: integer;
begin
if (size >= $8000)
then for i := 0 to (size div $8000) - 1 do
freemem(buff_ptr[i], $8000);
if size mod $8000 <> 0 then
freemem(buff_ptr[size div $8000], size mod $8000);
end;
function pgr_getbyte(offset: longint): byte;
begin
pgr_getbyte := buff_ptr[offset div $8000]^[offset mod $8000];
end;
procedure pgr_putbyte(offset: longint; value: byte);
begin
buff_ptr[offset div $8000]^[offset mod $8000] := value;
end;
procedure init_buffering;
begin
__p_graphgetmem := @pgr_graphgetmem;
__p_graphfreemem := @pgr_graphfreemem;
__p_graphgetbuff := @pgr_graphgetbuff;
__p_graphfreebuff := @pgr_graphfreebuff;
__p_putbyte := @pgr_putbyte;
__p_getbyte := @pgr_getbyte;
end;
BEGIN { PGRAPH unit body }
InitializeUnit
END. { PGRAPH unit body }